I conduct a STM (Strucutral Topic Model) estimation on a sample of 14,936 online news articles from seven news provider about domestic politics: Bild.de, DIE WELT, FOCUS ONLINE, SPIEGEL ONLINE, Stern.de, ZEIT ONLINE, Tagesschau.de. The articles are dated from 01.06.2017 to 31.12.2017 (German federal elections took place on 24th of September 2017.). I first extract all online articles using the the Eventregistry API. Then all articles from the section “domestic policy” are filtered by checking the URL structure.

To discover the latent topics in the corpus, the structural topic modeling (STM) developed by Roberts (2016) is applied. The STM is an unsupervised machine learning approach that models topics as multinomial distributions of words and documents as multinomial distributions of topics, allowing to incorporate external variables that effect both, topical content and topical prevalence. I will included the news provider as a control for both the topical content and the topical prevalence. Additional, the month an article was published is included as a control for the topical prevalence. The number of topics is set to 35.

Distribution of articles

The Figures below show the distribution of the number of articles from the respective news sources by date. There is a high peak around the federal elections on September, 24th.

ggsave({
  btw %>%
  ggplot(aes(site)) +
  geom_bar(fill=col[8], alpha = 0.8) +
  labs(x="", y="Number of articles") +
  theme(
      legend.position   = "none"
    )
  
},
filename = "../figs/bar.png", device = "png", 
width = 6, height = 4,
        dpi = 600)
plot1

plot1

ggsave({
  btw %>%
  group_by(date) %>%
  dplyr::summarise(obs = n()) %>%
  ggplot(aes(date, obs)) +
  geom_line(color=col[3]) +
  geom_vline(aes(xintercept=as.Date("2017-09-24")),
             linetype = 2, color=col[5]) +
  scale_color_manual(values = col) +
  labs(x="", y="number of articles",color="") +
  scale_x_date(breaks = date_breaks("1 month"), labels=date_format("%B", tz="CET")) +
  theme(
      legend.position   = "none",
      axis.title.x      = element_blank(),
      axis.text       = element_text(size = 8)
    )
},
filename = "../figs/timeline.png", device = "png",width = 6, height = 4,
dpi = 600
)
plot1

plot1

Model Results

1. Topic

1.1. Label topics

In order to improve readability and traceability, I assign a shorter name to the topics based on the most common words. The plotQuote function allows to inspect die most common words of a topic for each covariate.

topic <- 2

plotQuote(c(paste(sagelabs$covnames[1],":", 
                  paste(sagelabs$cov.betas[[1]]$problabels[topic,], collapse="\n")),
            paste(sagelabs$covnames[2],":",
                  paste(sagelabs$cov.betas[[2]]$problabels[topic,], collapse="\n")),
            paste(sagelabs$covnames[3],":", 
                  paste(sagelabs$cov.betas[[3]]$problabels[topic,], collapse="\n")),
            paste(sagelabs$covnames[4],":", 
                  paste(sagelabs$cov.betas[[4]]$problabels[topic,], collapse="\n")),
            paste(sagelabs$covnames[5],":", 
                  paste(sagelabs$cov.betas[[5]]$problabels[topic,], collapse="\n")),
            paste(sagelabs$covnames[6],":",
                  paste(sagelabs$cov.betas[[6]]$problabels[topic,], collapse="\n")),
            paste(sagelabs$covnames[7],":",
                  paste(sagelabs$cov.betas[[7]]$problabels[topic,], collapse="\n"))),
          text.cex = 0.8, width = 40
          )
topics <- matrix(c(1, "SPD", 2, "B90/ Die Grüne & DIE LINKE", 3, "Mix: Akhanli, Guttenberg, Bayern", 4, "Great Coalition debates", 5, "Diesel scandal", 6, "H.Kohl", 7, "Federal Election results", 8, "Europa, Macron, Schäuble", 9, "Mix: political trends, twitter", 10, "Merkel vs. Schulz", 11, "politics & democracy in GER", 12, "Deportation of criminal Refugees", 13, "A.Merkel", 14, "Text processing fail", 15, "Israel, antisemitism, D.Trump", 16, "Mix: political talkshows, Refugees", 17, "Votes within SPD", 18, "Election in Niedersachsen", 19, "R.Lammert", 20, "AfD, Right-wing extremist tendencies", 21, "German armed forces, v.d.Leyen", 22, "SPD, stuffing debates", 23, "CSU, Söder vs. Seehover, refugee cap", 24, "Bundespräsident F.-W.Steinmeier", 25, "Election polls", 26, "Jamaica failure", 27, "Jamaica Coalition debates", 28, "G20 in Hamburg", 29, "Federal Constitutional Court, Ministry of the Interior", 30, "F.Petri, AfD", 31, "D.Trump, Russia", 32, "Gauland, Weidel, AfD", 33, "German armed forces, Mali", 34, "Mix: Children, Education, Women", 35, "Left- rightwing Terror, police reports", 36, "Mix: people, Germany, democracy", 37, "AfD in parliament", 38, "EU policies", 39, "Mix: Terror attacks", 40, "Mix: Metoo, SPD", 41, "Terror attack Berlin (Amri)", 42, "Refugee family reunion", 43, "Mix: studies", 44, "Federal Constitutional Court (NSU, Franco, Terror)", 45, "Mix: minister of the interior, environment", 46, "CDU, J.Spahn, Tauber (Disease)", 47, "Church", 48, "public (budget) statistics, Education/ Healthcare/ Digital policies", 49, "Turkey", 50, "Höcke, Holocaust"), ncol=2, byrow=T)

topics.df <- as.data.frame(topics) %>%
  transmute(topic_name = paste(V1, V2, sep=": "),
         topic = 1:k)

1.2. Posterior distribution (gamma)

The theta Matrix is a DxK Matrix that gives us a probability for each topic (K) and each document (D)

# Document-topic probabilities
stmOut %>% tidy("theta") -> theta

To get a better understanding of the distribution of the “highest gamma”, we assign a topic to each document (topic with highest postertior distribution).

top_topics <- theta %>% 
  group_by(document) %>%
  mutate(therank = rank(-gamma)) %>%
  filter(therank == 1) %>%
  select(- therank)

btw.2 <- btw %>%
  mutate(document = articleID) %>%
  merge(.,top_topics, by="document") %>%
  ## Combine with Topic label
  merge(., topics.df, by="topic") %>%
  mutate(allocation = 1) 
ggplot(btw.2, aes(gamma)) +
  geom_density(fill=col[3], alpha = 0.8,
               color = col[3]) +
  labs(title = "Density Plot / Posterior distribution",
       y = "Theta")

1.3 Topic proportions

In order to get an initial overview of the results, the figure below displays the topics ordered by their expected frequency across the corpus (left side of the Figure) and the expected proportion of a topic in public media minus the expected proportion of topic use in private media (right side of the Figure). Thus topics more associated with public media appear to the right of zero. To assign a label to each topic, I looked at the most frequent words in that topic and the most representative articles.

keep <- seq(1:k)
Here, I create a Dataframe that contains the columns means of theta (per topic and covariate level)
frequency <- as.data.frame(colMeans(stmOut$theta)) %>%
  mutate(frequency = colMeans(stmOut$theta),
         topic = topics[,1],
         topic_name=paste(topics[,1],topics[,2], 
                          sep=": ")) %>%
  filter(topic %in% keep)

freq <- tapply(stmOut$theta[,1], stmOut$settings$covariates$betaindex, mean)
freq <- as.data.frame(freq) %>% 
    mutate(site=stmOut$settings$covariates$yvarlevels,
           topic = 1)

for(i in 2:k) {
  freq1 <- tapply(stmOut$theta[,i], stmOut$settings$covariates$betaindex, mean)
  freq1 <- as.data.frame(freq1) %>% 
    transmute(site=stmOut$settings$covariates$yvarlevels,
           topic = i,
           freq = freq1)
  
  freq <- rbind(freq, freq1)
}

freq <- freq %>%
  left_join(., topics.df, by = "topic") %>%
  #filter(topic %in% keep) %>%
  mutate(topic = topic_name) %>%
  left_join(., frequency %>% select(topic, frequency),
            by = "topic")

Next, we can plot the expected proportion of topic use in the overall corpus vs. the expected proportion of topic use for each medium.

p1 <- ggplot(frequency, aes(x=reorder(topic_name, frequency), y=frequency)) + 
    geom_col(fill=col[1], alpha=0.8) +
    coord_flip() +
    labs(x="", y="expected frequency") +
    theme(axis.text.x = element_text(size=8),
          axis.text.y = element_text(size=11),
          axis.title = element_text(size=10))

p1

p2 <- freq %>%
  mutate(topic =  as.numeric(gsub(":.*$","",topic))) %>% 
  ggplot(aes(reorder(topic_name,topic), freq)) +
  geom_col(fill = col[3]) +
  coord_flip() +
  facet_wrap(~site, ncol = 7) +
  theme(
    #axis.text.y = element_blank(),
          axis.text.y = element_text(size=11),
          axis.title = element_text(size=10)) +
    labs(x="", y="expected frequency") 

p2

We will conduct our further analysis on 15 selected topics which relate to political parties.

keep <- c(1,2,4,10,13,17,20,22,23,26,27,30,32,37,46)

1.4. Difference in topic prevalence

To identify which of these differences is significant, the conditional expectation of topic prevalence for given document characteristics can be estimated. More specifically, I estimate a linear model, where the documents are observations, the dependent variable is the posterior probability of a topic and the covariates are the metadata of documents (see equation below).

\[ \theta_d=\alpha+\beta_1x_{ownership}+\beta_2x_{month}+\epsilon \]

The estimateEffect() uses the method of composition to incorporate uncertainty in the dependent variable, drawing a set of topic proportions from the variational posterior repeated times and compute the coefficients as the average over all results.

effect <- estimateEffect(c(1:k) ~site, stmOut, 
                         metadata = out$meta, uncertainty = "None")

Here, I create a dataframe that contains the results of the estimation.

tables <- vector(mode="list", length = length(effect$topics))

for (i in seq_along(effect$topics)) {
  sims <- lapply(effect$parameters[[i]], function(x) stm:::rmvnorm(500, x$est, x$vcov))
  sims <- do.call(rbind, sims)
  est <- colMeans(sims)
  se <- sqrt(apply(sims,2, stats::var))
  tval <- est/se
  rdf <- nrow(effect$data) - length(est)
  p <- 2*stats::pt(abs(tval), rdf, lower.tail = FALSE)
  topic <- i
  
  coefficients <- cbind(topic, est, se, tval, p)
  rownames(coefficients) <- attr(effect$parameters[[1]][[1]]$est, "names") 
  colnames(coefficients) <- c("topic", "Estimate", "Std. Error", "t value", "p")
  tables[[i]] <- coefficients
}

out1 <- list(call=effect$call, topics=effect$topics, tables=tables)

coeff <- as.data.frame(do.call(rbind,out1$tables))

coeff <- coeff %>% 
  mutate(parameter = rownames(coeff),
         parameter = gsub("site", "", parameter),
         signifcant = ifelse(p <= 0.5,"yes","no")) %>%
  left_join(., topics.df, by="topic")

The following figure shows the regression results for each news page. The coefficients indicate the deviation from the base value of Bild.de (keeping the month equal).

p1 <- coeff %>% 
  filter(topic %in% keep) %>%
  filter(parameter %in% stmOut$settings$covariates$yvarlevels) %>%
  ggplot(aes(x = reorder(topic_name,topic, decreasing=F), y = Estimate, fill=factor(signifcant))) +
  geom_col() +
  scale_fill_manual(values = col[c(2,1)]) +
  scale_x_discrete(position = "top") +
  coord_flip() +
  facet_wrap(~parameter, ncol = 8, scales = "free_x") +
  labs(x="", fill="significant at the 5% level") +
  theme(legend.position = "top", 
        axis.text.y = element_text(size=9),
        axis.text.x = element_text(angle=90)) 

p1

ggsave(plot = p1, filename = "../figs/estimates.png", device = "png",width = 10, height = 7,
dpi = 600)

2. Tone

2.1. Plotquote

The plotQuote function allows to inspect die most common words of a topic for each covariate.

for (topic in keep) {
  
  png(filename = paste0("../figs/plotquote",topic,".png"), width = 300,
      height = 700)
  
  plotQuote(c(paste(sagelabs$covnames[1],":", 
                  paste(sagelabs$cov.betas[[1]]$problabels[topic,], collapse="\n")),
            paste(sagelabs$covnames[2],":",
                  paste(sagelabs$cov.betas[[2]]$problabels[topic,], collapse="\n")),
            paste(sagelabs$covnames[3],":", 
                  paste(sagelabs$cov.betas[[3]]$problabels[topic,], collapse="\n")),
            paste(sagelabs$covnames[4],":", 
                  paste(sagelabs$cov.betas[[4]]$problabels[topic,], collapse="\n")),
            paste(sagelabs$covnames[5],":", 
                  paste(sagelabs$cov.betas[[5]]$problabels[topic,], collapse="\n")),
            paste(sagelabs$covnames[6],":",
                  paste(sagelabs$cov.betas[[6]]$problabels[topic,], collapse="\n")),
            paste(sagelabs$covnames[7],":",
                  paste(sagelabs$cov.betas[[7]]$problabels[topic,], collapse="\n"))),
          text.cex = 0.8, width = 40,
          main = paste(topics.df$topic_name[topics.df$topic==topic])
          )
  dev.off()
}

2.2. Sentiment analysis

The idea of Sentiment analysis is to determine the attitude of a writer through online text data toward certain topic or the overall tonality of a document.

Lexical or “bag-ofwords” approaches are commonly used. In that approach, the researcher provides pre-defined dictionaries (lists) of words associated with a given emotion, such as negativity. The target text is then deconstructed into individual words (or tokens) and the frequencies of words contained in a given dictionary are then calculated.

2.2.1. Load sentiment dictionary.

SentimentWortschatz, or SentiWS for short, is a publicly available German-language resource for sentiment analysis, opinion mining etc. It lists positive and negative polarity bearing words weighted within the interval of [-1; 1] plus their part of speech tag, and if applicable, their inflections. The current version of SentiWS (v1.8b) contains 1,650 positive and 1,818 negative words, which sum up to 15,649 positive and 15,632 negative word forms incl. their inflections, respectively. It not only contains adjectives and adverbs explicitly expressing a sentiment, but also nouns and verbs implicitly containing one.

sent <- c(
  # positive Wörter
  readLines("dict/SentiWS_v1.8c_Negative.txt",
            encoding = "UTF-8"),
  # negative Wörter
  readLines("dict/SentiWS_v1.8c_Positive.txt",
            encoding = "UTF-8")
) %>% lapply(function(x) {
  # Extrahieren der einzelnen Spalten
  res <- strsplit(x, "\t", fixed = TRUE)[[1]]
  return(data.frame(words = res[1], value = res[2],
                    stringsAsFactors = FALSE))
}) %>%
  bind_rows %>% 
  mutate(word = gsub("\\|.*", "", words) %>% tolower,
         value = as.numeric(value)) %>%
  # manche Wörter kommen doppelt vor, hier nehmen wir den mittleren Wert
  group_by(word) %>% summarise(value = mean(value)) %>% ungroup

2.2.2. Apply the dictionary on the artciles.

To carry out the sentiment analysis we filter some documents from the corpus:

  1. Articles that have been assigned a topic with a probability of over 75% (gamma > 0.75).
  2. Articles assigned to one of the above mentioned topics.
  3. Some manual cleanups

After applying these filters, we still have about 2500 articles left to conduct the sentiment analysis. We now take each word in each article and assign a sentiment value for that word.

2.2.3. Check the analysis for a set of example documents.

sentDF %>% filter(document == unique(sentDF$document)[2]) %>%
  select(title, word, value, site) %>%
  htmlTable::htmlTable(align = "l")
title word value site
1 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! drei Bild.de
2 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! spd Bild.de
3 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! vorsitzende Bild.de
4 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! hat Bild.de
5 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! andrea Bild.de
6 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! nahles Bild.de
7 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! gestürzt Bild.de
8 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! oder Bild.de
9 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! an Bild.de
10 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! ihrem Bild.de
11 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! sturz -0.6316 Bild.de
12 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! mitgewirkt Bild.de
13 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! rudolf Bild.de
14 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! scharping Bild.de
15 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 1995 Bild.de
16 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! franz Bild.de
17 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! müntefering Bild.de
18 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 2005 Bild.de
19 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! und Bild.de
20 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! jetzt Bild.de
21 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! martin Bild.de
22 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! schulz Bild.de
23 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! heute Bild.de
24 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! tritt Bild.de
25 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! die Bild.de
26 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! die Bild.de
27 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 47 Bild.de
28 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! jährige Bild.de
29 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! selbst Bild.de
30 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! an Bild.de
31 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! die Bild.de
32 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! spitze 0.2112 Bild.de
33 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! der Bild.de
34 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! spd Bild.de
35 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! als Bild.de
36 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! erste Bild.de
37 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! frau Bild.de
38 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! in Bild.de
39 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! der Bild.de
40 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! geschichte Bild.de
41 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! der Bild.de
42 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! partei Bild.de
43 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! bis Bild.de
44 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! zum Bild.de
45 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! sonderparteitag Bild.de
46 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! im Bild.de
47 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! frühjahr Bild.de
48 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! wird Bild.de
49 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! sie Bild.de
50 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! allerdings Bild.de
51 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! nur Bild.de
52 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! kommissarische Bild.de
53 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! vorsitzende Bild.de
54 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! sein Bild.de
55 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! nahles Bild.de
56 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! praktizierende Bild.de
57 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! katholikin Bild.de
58 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! star Bild.de
59 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! trek Bild.de
60 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! fan Bild.de
61 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! mutter Bild.de
62 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! einer Bild.de
63 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 7 Bild.de
64 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! jährigen Bild.de
65 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! tochter Bild.de
66 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! und Bild.de
67 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! sonst Bild.de
68 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! die Bild.de
69 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! künftige Bild.de
70 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! spd Bild.de
71 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! spitzenfrau Bild.de
72 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! lebt Bild.de
73 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! gemeinsam 0.004 Bild.de
74 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! mit Bild.de
75 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! töchterchen Bild.de
76 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! ella Bild.de
77 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! marie Bild.de
78 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! und Bild.de
79 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! pferd Bild.de
80 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! siepke Bild.de
81 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! friese Bild.de
82 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! auf Bild.de
83 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! dem Bild.de
84 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! bauernhof Bild.de
85 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! ihrer Bild.de
86 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! urgroßeltern Bild.de
87 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! in Bild.de
88 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! der Bild.de
89 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! eifel Bild.de
90 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! fremdelt Bild.de
91 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! etwas Bild.de
92 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! mit Bild.de
93 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! den Bild.de
94 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! sozialen Bild.de
95 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! medien Bild.de
96 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! gerade Bild.de
97 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! mal Bild.de
98 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 16 Bild.de
99 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 000 Bild.de
100 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! follower Bild.de
101 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! bei Bild.de
102 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! facebook Bild.de
103 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! sigmar Bild.de
104 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! gabriel Bild.de
105 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 85 Bild.de
106 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 000 Bild.de
107 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! martin Bild.de
108 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! schulz Bild.de
109 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 470 Bild.de
110 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 000 Bild.de
111 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! zwei Bild.de
112 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! schwere Bild.de
113 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! schicksalsschläge Bild.de
114 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! mit Bild.de
115 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 16 Bild.de
116 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! und Bild.de
117 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! mit Bild.de
118 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 18 Bild.de
119 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! unfall -0.0048 Bild.de
120 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! beim Bild.de
121 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! weitsprung Bild.de
122 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! in Bild.de
123 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! der Bild.de
124 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! schule Bild.de
125 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 8 Bild.de
126 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! hüft Bild.de
127 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! ops Bild.de
128 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! seither Bild.de
129 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 50 Bild.de
130 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! schwerbehindert Bild.de
131 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! schwerer Bild.de
132 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! autounfall Bild.de
133 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! in Bild.de
134 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! schweden Bild.de
135 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! nicht Bild.de
136 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! angeschnallt Bild.de
137 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! daher Bild.de
138 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! die Bild.de
139 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! narbe Bild.de
140 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! auf Bild.de
141 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! der Bild.de
142 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! stirn Bild.de
143 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! ihr Bild.de
144 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! größter Bild.de
145 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! fan Bild.de
146 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! kanzlerin Bild.de
147 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! merkel Bild.de
148 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! die Bild.de
149 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! regierungschefin Bild.de
150 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! lobt Bild.de
151 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! überall Bild.de
152 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! nahles Bild.de
153 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! kompetenz 0.004 Bild.de
154 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! und Bild.de
155 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! faktensicherheit Bild.de
156 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! als Bild.de
157 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! ministerin Bild.de
158 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! sagt Bild.de
159 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! über Bild.de
160 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! sie Bild.de
161 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! mit Bild.de
162 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! ihr Bild.de
163 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! kann Bild.de
164 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! man Bild.de
165 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! arbeiten Bild.de
166 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! auch Bild.de
167 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! nach Bild.de
168 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! der Bild.de
169 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! trennung -0.5071 Bild.de
170 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! von Bild.de
171 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! ehemann Bild.de
172 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! marcus Bild.de
173 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! frings Bild.de
174 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 49 Bild.de
175 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! vor Bild.de
176 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! zwei Bild.de
177 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! jahren Bild.de
178 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! gab Bild.de
179 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! es Bild.de
180 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! keinen Bild.de
181 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! rosenkrieg Bild.de
182 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! beide Bild.de
183 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! elternteile Bild.de
184 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! kümmern 0.2016 Bild.de
185 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! sich Bild.de
186 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! gemeinsam 0.004 Bild.de
187 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! um Bild.de
188 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! tochter Bild.de
189 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! ella Bild.de
190 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! marie Bild.de
191 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! gemeinsamkeit Bild.de
192 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! mit Bild.de
193 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! ihrem Bild.de
194 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! parteifeind Bild.de
195 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! gabriel Bild.de
196 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! beide Bild.de
197 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! spielen Bild.de
198 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! akkordeon Bild.de

2.2.4. Calculate sentiment value by document

The sentiment score is calculated based on the weighted polarity values for a word, defined on an interval between -1 and 1. The score is then calculated from the sum of the words in a document (which can be assigned to a word from the dictionary) divided by the total number of words in that document.

\[ \text{Weighted}_d = \frac{|\text{positive polarity score}_d| - |\text{negative polarity score}_d|}{\text{Total Words}_d} \]

sentDF.values <- sentDF %>%
  select(document, word, value, 
         negative, positive,
         negative_d, positive_d) %>%
  group_by(document) %>%
  
  # calculate sum of positive and negative values
  summarise(sum_positive = sum(positive, na.rm = T),
            sum_negative = sum(negative, na.rm = T),
            sum_positive_d = sum(positive_d, na.rm = T),
            sum_negative_d = sum(negative_d, na.rm = T)) %>%

  # calculate diff
  mutate(sent_diff = sum_positive + sum_negative,
         sent_diff_d = sum_positive_d - sum_negative_d) %>%
  
  # combine with dataframe
  left_join(., df, 
            by = "document") %>%
  # calculate sentiment
  mutate(sentiment_d = sent_diff_d / text_length,
         sentiment = sent_diff / text_length) %>%
  
  # generate month & week
  mutate(week = week(date),
         month = month(date),
         year = year(date),
         yearmonth = calculate_month(month,year),
         yearweek = calculate_week(week, year))

2.2.5. Plot Sentiment Score

btw.2 %>% 
  mutate(yearmonth = calculate_month(month(date), year(date))) %>%
  group_by(yearmonth) %>%
  summarise(total_obs = n()) -> tally_month

btw.2 %>%
  group_by(site) %>%
  summarise(total_obs = n()) -> tally_site

btw.2 %>% 
  mutate(yearmonth = calculate_month(month(date),year(date))) %>%
  group_by(yearmonth, site) %>%
  summarise(total_obs = n()) -> tally_month_site

The following figure shows the results of the analysis for each topic on a monthly basis, aggregated on all newspaper. Each sentiment value is weighted by the relative share of the topic in the overall reporting of that month.

\[ \text{w} = \frac{\text{# of obs per month & topic}}{\text{# of obs per month}} \]

\[ \text{weighted sentiment} = \text{sentiment} * \text{w} \]

Some conclusions can be drawn from this illustration. First of all, it is clear that topics concerning the AfD (20, 30, 32, 37) are discussed in a negative way over the entire period, with an exepction for topic 30, dealing with Frauk Petry and the AfD. The topic that is discussed most negatively is that of the right-wing extremist tendencies within the AfD. Another striking result is that the sentiment score of topics topics that deal with the SPD alone (1, 22) is diminishing in the course of time. The topic, which contains the CDU in isolation (46), is rather zigzagging, with a high peak in November 2017 and a low peak in January 2018, but there is only one observation this month, which is an article about Peter Tauber’s illness.

Concerning the issues that discuss possible coalitions, it is evident that there was a month in which the Jamaican coalition was positively discussed (topic 27): October 2017, when coalition talks were in full swing. With the failure of the negotiations, the sentiment value of the articles also decreases, while the number of articles dealing with this topic increases sharply in the short term (to 210 articles) and decreases significantly in the following months. It is striking that precisely at this time (December 2017), both the observations, as well as the sentiment value of the articles that report on the grand coalition increase (topic 4).

By Month & Topic
p <- sentDF.values %>%
  group_by(yearmonth, topic_name, topic) %>%
  summarise(sentiment = mean(sentiment, na.rm=T),
            obs = n()) %>%
  left_join(., tally_month, by = "yearmonth") %>%
  mutate(w = obs / total_obs,
         sentiment_w = sentiment * w)

p1 <- ggplot(p, 
       aes(yearmonth, sentiment, 
           group = topic_name,
           label = obs)) +
  facet_wrap(~topic_name, nrow = 3) +
  geom_col(fill = col[1], alpha = 0.7) +
 geom_line(color = col[2], size = 0.8) +
  #geom_text() +
  geom_hline(yintercept = 0, linetype = 2,
             color = "black") +
  labs(x="", y="",
       title = "Monthly Sentiment Score",
       subtitle = "unweighted") +
  theme(axis.text.y = element_text(size=8),
        axis.text.x = element_text(size = 10))

p2 <- ggplot(p, 
       aes(yearmonth, sentiment_w, 
           group = topic_name,
           label = obs)) +
  facet_wrap(~topic_name, nrow = 3) +
  geom_col(fill = col[2], alpha = 0.7) +
 geom_line(color = col[1], size = 0.8) +
  #geom_text() +
  geom_hline(yintercept = 0, linetype = 2,
             color = "black") +
  labs(x="", y="",
       title = "",
       subtitle = "weighted") +
  theme(axis.text.y = element_text(size=8),
        axis.text.x = element_text(size = 10))

p1 + p2 + plot_layout(ncol = 1)

By Site and Topic

The following figure shows the results of the analysis for each topic and each newspaper, aggregated over time. Each sentiment value is weighted by the relative share of the topic in the overall political news coverage of that online newspaper.

\[ \text{w} = \frac{\text{# of obs per newspaper & topic}}{\text{# of obs per newspaper}} \]

\[ \text{weighted sentiment} = \text{sentiment} * \text{w} \]

p <- sentDF.values %>%
  group_by(site, topic_name, topic) %>%
  summarise(sentiment = mean(sentiment, na.rm=T),
            obs = n()) %>%
  left_join(., tally_site, by = "site") %>%
  mutate(w = obs/total_obs,
         sentiment_w = sentiment * w)

p1 <- ggplot(p, 
       aes(reorder(topic_name, topic), 
           sentiment, 
           group = site,
           label = obs)) +
  geom_col(fill=col[2], alpha = 0.7) +
  #geom_line(color = col[1], size = 0.8) +
  #geom_text(size = 2.5) +
  geom_hline(yintercept = 0, linetype = 2,
             color = "black") +
  coord_flip() +
  facet_wrap(~site, ncol = 7) +
  labs(x="", y="",
       title = "Sentiment Score",
       subtitle = "unweighted") +
  theme(axis.text.y = element_text(size = 10),
        axis.text.x = element_text(size=6))

p2 <- ggplot(p, 
       aes(reorder(topic_name, topic), 
           sentiment_w, 
           group = site,
           label = obs)) +
  geom_col(fill=col[1], alpha = 0.7) +
  #geom_line(color = col[2], size = 0.8) +
  #geom_text(size = 2.5) +
  geom_hline(yintercept = 0, linetype = 2,
             color = "black") +
  coord_flip() +
  facet_wrap(~site, ncol = 7) +
  labs(x="", y="",
       title = "",
       subtitle = "weighted") +
  theme(axis.text.y = element_text(size = 10),
        axis.text.x = element_text(size=6))

p1 + p2 + plot_layout(ncol = 1)

Radar plot
require(ggiraph)
require(ggiraphExtra)
sentDF.values %>%
  group_by(site, topic_name) %>%
  summarise(sentiment = mean(sentiment, na.rm=T)) %>%
  spread(key=topic_name, value=sentiment) -> radar

radar %>%
  ggRadar(aes(color=site), 
          rescale = F,
          alpha = 0, legend.position = "right") +
  labs(title = "Sentiment score Jun 2017-March 2018",
       subtitle = "unweighted") +
  guides(col = guide_legend(nrow = 1)) +
  theme(legend.position = "bottom")

sentDF.values %>%
  group_by(site, topic_name) %>%
  summarise(sentiment = mean(sentiment, na.rm=T),
            obs = n()) %>%
  left_join(., tally_site, by = "site") %>%
  mutate(w = obs/total_obs,
         sentiment_w = sentiment * w) %>%
  select(site, topic_name, sentiment_w) %>%
  spread(key=topic_name, value=sentiment_w) -> radar

radar %>%
  ggRadar(aes(color=site), 
          rescale = F,
          alpha = 0, legend.position = "right") +
  labs(title = "Sentiment score Jun 2017-March 2018",
       subtitle = "weighted") +
  guides(col = guide_legend(nrow = 1)) +
  theme(legend.position = "bottom")

3. Compare with polls

We use the data from the “Sonntagsumfrage” (Sunday survey) from infratest dimap. The institution regularly asks at least 1000 German citizens the question: “Which party would you choose if federal elections take place next Sunday?” The survey thus measures the current election tendencies and therefore reflects an intermediate state in the opinion-forming process of the electoral population.

The comparison with the sentiment value of individual topics is intended to show whether there is a correlation between the current tendency to vote and the type of reporting. For this purpose, the monthly average of both time series is calculated and rescaled to an interval between 0 and 1.

The analysis in this section is done in two steps: First, the standardised time series are compared graphically. In the second step, the cross-correlation between two time series is calculated.

Normalization

\[ z_i = \frac{x_i-\text{min}(x)}{\text{max}(x)-\text{min}(x)} \] where \(x = (x_1,...,x_n)\) and \(z_i\) is the \(i^{th}\) normalized data.

# Import and prepare survey data
load("../output/polls.Rda")

polls <- table_long %>%
  mutate(month=month(Datum),
         year = year(Datum),
         yearmonth = calculate_month(month,year)) %>%
  group_by(yearmonth,party) %>%
  summarise(mean_val = mean(value, na.rm=T)) %>%
  ungroup() %>%
  filter(mean_val != "NaN") %>%
  select(party, yearmonth, mean_val) %>%
  spread(party, mean_val)
polls.red <- polls %>%
  filter(yearmonth > as.Date("2017-05-01")) %>%
  transmute(Union = normalize_data(Union),
         SPD = normalize_data(SPD),
         Grüne = normalize_data(Grüne),
         FDP = normalize_data(FDP),
         AfD = normalize_data(AfD),
         yearmonth = yearmonth)

# topics.red <- sentDF.values %>%
#   filter(grepl(paste("CDU","CSU","coalition", sep="|"), 
#                topic_name, ignore.case = T))
### by time
group1 <- sentDF.values %>%
  group_by(yearmonth, topic_name, topic) %>%
  summarise(sentiment = mean(sentiment, na.rm=T),
            obs = n()) %>%
  ungroup() %>%
  left_join(., tally_month, by="yearmonth") %>%
  mutate(w = obs / total_obs,
         sentiment_w = sentiment * w,
         sentiment_n = normalize_data(sentiment_w)) 

### by time and site
group2 <- sentDF.values %>%
  group_by(yearmonth, topic_name, topic, site) %>%
  summarise(sentiment = mean(sentiment, na.rm=T),
            obs = n()) %>%
  ungroup() %>%
  left_join(., tally_month_site, by=c("yearmonth","site")) %>%
  mutate(w = obs / total_obs,
         sentiment_w = sentiment * w,
         sentiment_n = normalize_data(sentiment_w))
ggplot(group1, aes(yearmonth, 
                   sentiment_n, 
                   group = topic_name,
                   color = topic_name)) +
  geom_line(show.legend = F) +
  facet_wrap(~topic_name, nrow = 3) +
  labs(x="", y="", title="Sentiment Score")

polls.red %>%
  gather(key = party, value = poll, Union:AfD) %>%
  ggplot(aes(yearmonth, poll, color = party)) +
  geom_line() +
  labs(x="", y="", title = "Survey Value", color = "")

3.1. Cross-Correlation

group1 %>%
  select(yearmonth, topic_name, sentiment_n) %>%
  spread(topic_name, sentiment_n) %>%
  select(- yearmonth) -> corr1

polls.red %>% select(- yearmonth) -> corr2

corr <- expand.grid(names(corr1), names(corr2))
corr$correlation <- NA
x <- 1

for (corr1Id in 1:ncol(corr2)) {
  c1 = corr2[,corr1Id]
  #print(names(corr2[,corr1Id]))
  for(corr2Id in 1:ncol(corr1)) {
    c2 = corr1[,corr2Id]
    #print(names(corr1[,corr2Id]))
    correlation = ccf(c1, c2, lag.max = 0,
                      na.action = na.contiguous, plot=F)
    corr[x,3] <- correlation$acf[1]
    
    x<- x+1
  }
}
ggplot(corr, aes(Var2, Var1,
                 fill = correlation,
                 label = round(correlation,2))) +
  geom_tile(color="white") +
  geom_text(size = 3, color = col[5]) +
  viridis::scale_fill_viridis() +
  labs(x="", y="", title = "Cross Correlation of Polls vs. Sentiment Value")

3.2. Graphical analysis

3.2.1. CDU
### Plot 1  
plot1 <- group1 %>%
  filter(grepl(paste("CDU","CSU",sep="|"), topic_name))

p1 <- ggplot() +
  geom_col(data=plot1, aes(yearmonth, sentiment_n, 
             group = topic_name,
             fill = topic_name),
           position = "dodge", 
           alpha = 0.8) +
  scale_fill_manual(values = col) +
    geom_line(data=plot1, aes(yearmonth, sentiment_n, 
             group = topic_name,
             color = topic_name),
             show.legend = F) +
  scale_color_manual(values = col) +
  guides(fill = guide_legend(ncol=3)) +
  # Add poll line
  geom_line(data = polls.red, 
            aes(yearmonth, Union),
            color = "black",
            size = 1) +
  labs(y="", x="", fill="",
       title = "Sentiment & Poll Values",
       subtitle = "Both scores are normalized") +
  scale_x_date(breaks = date_breaks("1 month"), labels=date_format("%B", tz="CET")) +
  theme(legend.position = "bottom") 

### Plot 2
plot2 <- group2 %>%
  filter(grepl(paste("CDU","CSU",sep="|"), topic_name))

p2 <- ggplot() +
  geom_col(data = plot2,
           aes(yearmonth, sentiment_n, 
             group = topic_name,
             fill = topic_name),
           alpha = 0.8,
           position = "dodge") +
    scale_fill_manual(values = col) +
    scale_color_manual(values = col) +
  geom_line(data = plot2,
            aes(yearmonth, sentiment_n,
                group = topic_name,
                color = topic_name),
            show.legend = F) +
  facet_wrap(~site, ncol = 2) +
   # Add poll line
  geom_line(data = polls.red, 
            aes(yearmonth, Union),
            color = "black",
            size = 1) +
  labs(y="", x="", fill="") +
  scale_x_date(breaks = date_breaks("1 month"), labels=date_format("%B", tz="CET")) +
  theme(legend.position = "none",
        axis.text.x = element_text(angle = 90))

p1 + p2 + plot_layout(ncol = 1, heights = c(1,4))

SPD

plot1 <- group1 %>%
  filter(grepl(paste("SPD", sep="|"), topic_name, ignore.case = T))

### Plot 1  
p1 <- ggplot() +
  geom_col(data=plot1, aes(yearmonth, sentiment_n, 
             group = topic_name,
             fill = topic_name),
           position = "dodge", 
           alpha = 0.8) +
  scale_fill_manual(values = col) +
  guides(fill = guide_legend(ncol=3)) +
   geom_line(data=plot1, aes(yearmonth, sentiment_n, 
             group = topic_name,
             color = topic_name),
             show.legend = F) +
  scale_color_manual(values = col) +
  # Add poll line
  geom_line(data = polls.red, 
            aes(yearmonth, SPD),
            color = "red",
            size = 1) +
  labs(y="", x="", fill="",
       title = "Sentiment & Poll Values",
       subtitle = "Both scores are normalized") +
  scale_x_date(breaks = date_breaks("1 month"), labels=date_format("%B", tz="CET")) +
  theme(legend.position = "bottom") 

### plot by time and site
plot2 <- group2 %>%
  filter(grepl(paste("SPD", sep="|"), topic_name, ignore.case = T))

### Plot 2
p2 <- ggplot() +
  geom_col(data = plot2,
           aes(yearmonth, sentiment_n, 
             group = topic_name,
             fill = topic_name),
           alpha = 0.8,
           position = "dodge") +
  scale_fill_manual(values = col) +
  facet_wrap(~site, ncol = 2) +
     geom_line(data=plot2, aes(yearmonth, sentiment_n, 
             group = topic_name,
             color = topic_name),
             show.legend = F) +
  scale_color_manual(values = col) +
   # Add poll line
  geom_line(data = polls.red, 
            aes(yearmonth, SPD),
            color = "red",
            size = 1) +
  labs(y="", x="", fill="") +
  scale_x_date(breaks = date_breaks("1 month"), labels=date_format("%B", tz="CET")) +
  theme(legend.position = "none",
        axis.text.x = element_text(angle = 90))

p1 + p2 + plot_layout(ncol = 1, heights = c(1,4))